home *** CD-ROM | disk | FTP | other *** search
/ Delphi Informant Complete 1995 - 2000 / Delphi Informant Complete 1995 to 2000.iso / Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar / 1998 / Nov / di9811gd / Example4 / DllCode.pas < prev    next >
Pascal/Delphi Source File  |  1998-04-25  |  2KB  |  84 lines
  1. unit DllCode;
  2.  
  3. interface
  4.  
  5. uses Windows, Dialogs, SysUtils, Forms;
  6.  
  7. type
  8.   TTestObject = class(TObject)
  9.   public
  10.     ObjectName: String;
  11.     constructor Create;
  12.   end;
  13.  
  14. procedure DllShowMessage(Msg: String);
  15. procedure CreateObject;
  16. procedure FreeObject;
  17.  
  18. var
  19.   tlsObjectIndex: DWord;
  20.  
  21. const
  22.   MessageBoxTitle = 'Dll4';
  23.   CRLF = #13 + #10;
  24.  
  25. implementation
  26.  
  27. procedure DllShowMessage(Msg: String);
  28. begin
  29.   MessageBox(GetDesktopWindow, PChar(Msg), MessageBoxTitle,
  30.              MB_OK or MB_SETFOREGROUND or MB_TASKMODAL);
  31. end;
  32.  
  33. procedure CreateObject;
  34. begin
  35.   { First, create the new object and store it in the thread-local
  36.     slot referred to by tlsObjectIndex. }
  37.   TLSSetValue(tlsObjectIndex, Pointer(TTestObject.Create));
  38.   { Now, get the object that was just created and display
  39.     its ObjectName property. }
  40.   DllShowMessage(TTestObject(TLSGetValue(tlsObjectIndex)).ObjectName);
  41. end;
  42.  
  43. procedure FreeObject;
  44. begin
  45.   { First, get the thread-local value and report that it is nil or
  46.     give the ObjectName property that was stored there. }
  47.   if (TLSGetValue(tlsObjectIndex) = nil) then
  48.     DllShowMessage('Object is nil.')
  49.   else
  50.     DllShowMessage(TTestObject(TLSGetValue(tlsObjectIndex)).ObjectName);
  51.   { Free up the object }
  52.   TTestObject(TLSGetValue(tlsObjectIndex)).Free;
  53.   { Set its value in the thread-local store to nil. }
  54.   TLSSetValue(tlsObjectIndex, nil);
  55. end;
  56.  
  57. { TTestObject }
  58. constructor TTestObject.Create;
  59. begin
  60.   ObjectName := 'Test Object: ' + IntToStr(GetCurrentThreadID);
  61. end;
  62.  
  63. procedure DllEntry(Reason: Integer);
  64. begin
  65.   case Reason of
  66.     DLL_THREAD_ATTACH:  CreateObject;
  67.     DLL_THREAD_DETACH:  FreeObject;
  68.   end;
  69. end;
  70.  
  71. initialization
  72.  
  73.   IsMultiThread := True;
  74.   tlsObjectIndex := TLSAlloc;
  75.   DllProc := @DllEntry;
  76.   CreateObject;
  77.  
  78. finalization
  79.  
  80.   FreeObject;
  81.   TLSFree(tlsObjectIndex);
  82.  
  83. end.
  84.